home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir38 / manythng.zip / MANYTHNG.BAS < prev    next >
BASIC Source File  |  1993-04-15  |  4KB  |  116 lines
  1. ' ManyThng.BAS -- This is my attempt at a variable screen saver
  2. '   It is based on an example in "Learn Programming and Visual Basic 2.0"
  3. '   by John Socha and Sybex Inc., (highly recommended)
  4.  
  5. ' first written 4-15-93 Bruce McLean
  6. '
  7. Option Explicit
  8.  
  9. Declare Function ShowCursor Lib "USER" (ByVal fShow As Integer) As Integer
  10.  
  11. 'routines for reading profile data in 'CONTROL.INI'
  12. Declare Function GetPrivateProfileInt Lib "KERNEL" (ByVal lpszSectionName As String, ByVal lpszKeyName As String, ByVal nDefault As Integer, ByVal lpszFileName As String) As Integer
  13. Declare Function WritePrivateProfileString Lib "KERNEL" (ByVal lpszSectionName As String, ByVal lpszKeyName As String, ByVal nString As String, ByVal lpszFileName As String) As Integer
  14.  
  15. '
  16. ' These variables support saving the maximum number of lines
  17. ' in the CONTROL.INI file, which is where the Windows 3.1
  18. ' screen savers save setup information.
  19. '
  20. Global MaxLines As Integer      ' Lines to show before CLS
  21. Global RepeatCount As Integer   ' # of lines the same color
  22. Global MaxChangeMinutes As Integer   ' minutes to go before changing color
  23. Global MaxCums As Integer      ' total number of lines before clearing screen
  24.  
  25. Global Const iniName = "CONTROL.INI"
  26. Global Const secName = "Screen Saver.Many Things"
  27. Global Const keyName = "MaxLines"
  28. Global Const RepeatName = "RepeatCount"
  29. Global Const ChangeMinutesName = "MaxChangeMinutes"
  30. Global Const MaxCumsName = "MaxCumLines"
  31.  
  32. ' windows defines
  33. Type RECT
  34.     left As Integer
  35.     top As Integer
  36.     right As Integer
  37.     bottom As Integer
  38. End Type
  39.  
  40. ' routines for capturing screen
  41. Declare Sub BitBlt Lib "GDI" (ByVal DestDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal BWidth As Integer, ByVal BHeight As Integer, ByVal SourceDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal Constant As Long)
  42. Declare Function CopyRect Lib "User" (lpDestRect As RECT, lpSourceRect As RECT) As Integer
  43. Declare Function CreateDC Lib "GDI" (ByVal Driver As Any, ByVal Dev As Any, ByVal O As Any, ByVal Init As Any) As Integer
  44. Declare Sub DeleteDC Lib "GDI" (ByVal hDC As Integer)
  45. Declare Sub DrawIcon Lib "User" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal hIcon As Integer)
  46. Declare Function GetCursor Lib "User" () As Integer
  47. Declare Sub GetCursorPos Lib "User" (lpPNT As Integer)
  48. Declare Function GetDeviceCaps Lib "GDI" (ByVal hDC As Integer, ByVal nIndex As Integer) As Integer
  49. Declare Function LockResource Lib "Kernel" (ByVal hRes As Integer) As Long
  50. Declare Sub UnlockResource Lib "Kernel" Alias "GlobalUnlock" (ByVal hRes As Integer)
  51.  
  52. ' variables and constants to be used for screen capture
  53. Dim ScrnW As Integer, ScrnH As Integer
  54. Dim RECT(3) As Integer
  55. Const HORZRES = 8
  56. Const VERTRES = 10
  57.  
  58. Sub EndScrnsave ()
  59.     ShowMouse                   ' Make mouse pointer visible again
  60.     End                         ' And exit
  61. End Sub
  62.  
  63. Sub HideMouse ()
  64.     While ShowCursor(False) >= 0
  65.     Wend
  66. End Sub
  67.  
  68. Sub Main ()
  69.     
  70.     Dim i As Integer
  71.     Dim DC As Integer
  72.  
  73.     ' check if first instance of program so we can be sure that only one is running
  74.     If App.PrevInstance Then End
  75.  
  76.     ' first capture screen into Form 'Original' for later use
  77.     DC = CreateDC("DISPLAY", 0&, 0&, 0&)
  78.     ScrnW = GetDeviceCaps(DC, HORZRES)
  79.     ScrnH = GetDeviceCaps(DC, VERTRES)
  80.     BitBlt Original.hDC, 0, 0, ScrnW, ScrnH, DC, 0, 0, &HCC0020
  81.     DeleteDC DC
  82.  
  83.     '
  84.     ' This next line of code gets a number from the CONTROL.INI
  85.     ' file in your Windows directory.  This number is the maximum
  86.     ' number of lines to draw before clearing the screen.
  87.     '
  88.     MaxLines = GetPrivateProfileInt(secName, keyName, 100, iniName)
  89.     RepeatCount = GetPrivateProfileInt(secName, RepeatName, 30, iniName)
  90.     MaxChangeMinutes = GetPrivateProfileInt(secName, ChangeMinutesName, 1, iniName)
  91.     MaxCums = GetPrivateProfileInt(secName, MaxCumsName, 500, iniName)
  92.     
  93.     ' Check to see if we should blank the screen, or display
  94.     ' the Setup dialog box.
  95.     '
  96.     If InStr(Command$, "/c") Then
  97.         SetupForm.Show 1
  98.     ElseIf InStr(Command$, "/s") Then
  99.         BackGround.Show
  100.     End If
  101.  
  102.     'Randomize
  103.  
  104.     '
  105.     ' Wait until there are no form visible, then quit.
  106.     '
  107.     While DoEvents() > 0        ' Loop until no forms visible
  108.     Wend
  109. End Sub
  110.  
  111. Sub ShowMouse ()
  112.     While ShowCursor(True) < 0
  113.     Wend
  114. End Sub
  115.  
  116.